home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-vos.el.z / efs-vos.el
Encoding:
Text File  |  1998-05-21  |  9.8 KB  |  286 lines

  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-vos.el
  5. ;; Description:  VOS support for efs
  6. ;; Release:      $efs release: 1.15 $
  7. ;; Version:      #Revision: 1.1 $
  8. ;; RCS:          
  9. ;; Author:       Sandy Rutherford <sandy@ibm550.sissa.it>
  10. ;; Created:      Sat Apr  3 03:05:00 1993 by sandy on ibm550
  11. ;; Modified:     Sun Nov 27 18:45:24 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. ;;; The original ange-ftp VOS support was written by Joe Wells <jbw@cs.bu.edu>
  20.  
  21. ;;; Thank you to Jim Franklin <jimf%shared@uunet.uu.net> for providing
  22. ;;; information on the VOS operating system.
  23.  
  24. (provide 'efs-vos)
  25. (require 'efs)
  26.  
  27. (defconst efs-vos-version
  28.   (concat (substring "$efs release: 1.15 $" 14 -2)
  29.       "/"
  30.       (substring "#Revision: 1.1 $" 11 -2)))
  31.  
  32. ;;;;---------------------------------------------------------------
  33. ;;;; VOS support for efs
  34. ;;;;---------------------------------------------------------------
  35.  
  36. ;;; A legal VOS pathname is of the form:
  37. ;;; %systemname#diskname>dirname>dirname>dir-or-filename
  38. ;;;
  39. ;;; Each of systemname, diskname, dirname, dir-or-filename can be
  40. ;;; at most 32 characters.
  41. ;;; Valid characters are all alpha, upper and lower case, all digits,
  42. ;;; plus: @[]\^`{|}~"$+,-./:_
  43. ;;; restrictions: name cannot begin with hyphen (-) or period (.)
  44. ;;;               name must not end with a period (.)
  45. ;;;               name must not contain two adjacent periods (.)
  46. ;;;
  47. ;;; Invalid characters are:
  48. ;;;               non-printing control characters
  49. ;;;               SPACE and DEL
  50. ;;;               !#%&'()*;<=>?
  51. ;;;               all other ascii chars
  52. ;;;
  53. ;;; The full pathname must be less than or equal to 256 characters.
  54. ;;; VOS pathnames are CASE-SENSITIVE.
  55. ;;; The may be a directory depth limitation of 10 (newer versions may have
  56. ;;; eliminated this).
  57.  
  58. ;;; entry points
  59.  
  60. (efs-defun efs-fix-path vos (path &optional reverse)
  61.   ;; Convert PATH from UNIX-ish to VOS.
  62.   ;; If REVERSE given then convert from VOS to UNIX-ish.
  63.   ;; Does crude checking for valid path syntax, but is by no means exhaustive.
  64.   (efs-save-match-data
  65.     (if reverse
  66.     (if (string-match "^\\(\\(%[^#>%]+\\)?#[^>#%]+\\)?>[^>#%]" path)
  67.         (let ((marker (1- (match-end 0)))
  68.           (result "/")
  69.           system drive)
  70.           (if (match-beginning 1)
  71.           (if (match-beginning 2)
  72.               (setq system (substring path 1 (match-end 2))
  73.                 drive (substring path (1+ (match-end 2))
  74.                          (match-end 1)))
  75.             (setq drive (substring 1 (match-end 1)))))
  76.           (while (string-match ">" path marker)
  77.         (setq result (concat result
  78.                      (substring path marker
  79.                         (match-beginning 0))
  80.                      "/")
  81.               marker (match-end 0)))
  82.           (if drive
  83.           (if system
  84.               (concat "/" system "/" drive result
  85.                 (substring path marker))
  86.             (concat "/" drive result (substring path marker)))
  87.         (concat result (substring path marker))))
  88.       (error "Invalid VOS pathname %s" path))
  89.     (if (string-match "^/\\([^/]+\\)/\\([^/]+\\)/[^/]" path)
  90.     (let ((marker (1- (match-end 0)))
  91.           (result (concat "%"
  92.                   (substring path
  93.                      (match-beginning 1)
  94.                      (match-end 1))
  95.                   "#"
  96.                   (substring path
  97.                      (match-beginning 2)
  98.                      (match-end 2))
  99.                   ">")))
  100.       ;; I'm guessing that VOS doesn't have a directory syntax.
  101.       (setq path (efs-internal-directory-file-name path))
  102.       (while (string-match "/" path marker)
  103.         (setq result
  104.           (concat result
  105.               (substring path marker
  106.                      (match-beginning 0))
  107.               ">")
  108.           marker (match-end 0)))
  109.       (concat result (substring path marker)))
  110.       (error "Cannot convert path %s to VOS." path)))))
  111.  
  112. (efs-defun efs-fix-dir-path vos (dir-path)
  113.   ;; Convert path from UNIX-ish to VMS ready for a DIRectory listing.
  114.   (cond ((string-equal dir-path "/")
  115.      (error "Cannot gork VOS system names"))
  116.     ((string-match "^/[^/]/$" dir-path)
  117.      (error "Cannot grok VOS devices"))
  118.     ((efs-fix-path 'vos dir-path))))
  119.  
  120. (defconst efs-vos-date-and-time-regexp
  121.   (concat
  122.    "\\(^\\| \\)" ; For links, this must match at the beginning of the line.
  123.    "[678901][0-9]-[01][0-9]-[0-3][0-9] [012][0-9]:[0-6][0-9]:[0-6][0-9]  "))
  124. ;; Regexp to match a VOS file line. The end of the regexp must correspond
  125. ;; to the start of the filename.
  126.  
  127. (defmacro efs-vos-parse-filename ()
  128.   ;; Return the VOS filename on the current line of a listing.
  129.   ;; Assumes that the point is at the beginning of the line.
  130.   ;; Return nil if no filename is found.
  131.   (` (let ((eol (save-excursion (end-of-line) (point))))
  132.        (and (re-search-forward efs-vos-date-and-time-regexp eol t)
  133.         (buffer-substring (point) eol)))))
  134.  
  135. (efs-defun efs-parse-listing vos
  136.   (host user dir path &optional switches)
  137.   ;; Parse the current buffer which is assumed to be in MultiNet FTP dir
  138.   ;; format, and return a hashtable as the result. SWITCHES are never used,
  139.   ;; but they must be specified in the argument list for compatibility
  140.   ;; with the unix version of this function.
  141.   ;; HOST = remote host name
  142.   ;; USER = user name
  143.   ;; DIR = directory in as a full remote path
  144.   ;; PATH = directory in full efs path syntax
  145.   ;; SWITCHES = ls switches (not relevant here)
  146.   (goto-char (point-min))
  147.   (efs-save-match-data
  148.     (let (tbl file)
  149.       ;; Look file files.
  150.       (if (search-forward "\nFiles: " nil t)
  151.       (progn
  152.         (setq tbl (efs-make-hashtable))
  153.         (forward-line 1)
  154.         (skip-chars-forward "\n")
  155.         (while (setq file (efs-vos-parse-filename))
  156.           (efs-put-hash-entry file '(nil) tbl)
  157.           (forward-line 1))))
  158.       ;; Look for directories.
  159.       (if (search-forward "\nDirs: " nil t)
  160.       (progn
  161.         (or tbl (setq tbl (efs-make-hashtable)))
  162.         (forward-line 1)
  163.         (skip-chars-forward "\n")
  164.         (while (setq file (efs-vos-parse-filename))
  165.           (efs-put-hash-entry file '(t) tbl)
  166.           (forward-line 1))))
  167.       ;; Look for links
  168.       (if (search-forward "\nLinks: " nil t)
  169.       (let (link)
  170.         (or tbl (setq tbl (efs-make-hashtable)))
  171.         (forward-line 1)
  172.         (skip-chars-forward "\n")
  173.         (while (setq file (efs-vos-parse-filename))
  174.           (if (string-match " ->  \\([^ ]+\\)" file)
  175.           ;; VOS puts a trailing blank after the name of a symlink
  176.           ;; target. Go figure...
  177.           (setq link (substring file (match-beginning 1) (match-end 1))
  178.             file (substring file 0 (match-beginning 0)))
  179.         (setq link "")) ; weird?
  180.           (efs-put-hash-entry file (list link) tbl)
  181.           (forward-line 1))))
  182.       ;; This returns nil if no headings for files, dirs, or links
  183.       ;; are found. In this case, we're assuming that it isn't a valid
  184.       ;; listing.
  185.       (if tbl
  186.       (progn
  187.         (efs-put-hash-entry "." '(t) tbl)
  188.         (efs-put-hash-entry ".." '(t) tbl)))
  189.       tbl)))
  190.     
  191. (efs-defun efs-allow-child-lookup vos (host user dir file)
  192.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  193.   ;; according to its file-name syntax, and therefore a child listing should
  194.   ;; be attempted.
  195.   ;; Directoried don't have a size.
  196.   (string-match ": not a file\\.$"
  197.         (cdr (efs-send-size host user (concat dir file)))))
  198.  
  199. ;;; Tree Dired Support
  200.  
  201. (defconst efs-dired-vos-re-exe
  202.   "^.  +e ")
  203.  
  204. (or (assq 'vos efs-dired-re-exe-alist)
  205.     (setq efs-dired-re-exe-alist
  206.       (cons (cons 'vos  efs-dired-vos-re-exe)
  207.         efs-dired-re-exe-alist)))
  208.  
  209. (defconst efs-dired-vos-re-dir
  210.   "^.  +[nsm] +[0-9]+ +[678901][0-9]-")
  211.  
  212. (or (assq 'vos efs-dired-re-dir-alist)
  213.     (setq efs-dired-re-dir-alist
  214.       (cons (cons 'vos  efs-dired-vos-re-dir)
  215.         efs-dired-re-dir-alist)))
  216.  
  217. (efs-defun efs-dired-manual-move-to-filename vos
  218.   (&optional raise-error bol eol)
  219.   ;; In dired, move to the first char of filename on this line, where
  220.   ;; line can be delimited by either \r or \n.
  221.   ;; Returns (point) or nil if raise-error is nil and there is no
  222.   ;; filename on this line. In the later case, leaves the point at the
  223.   ;; beginning of the line.
  224.   ;; This version is for VOS.
  225.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  226.   (let (case-fold-search)
  227.     (if bol
  228.     (goto-char bol)
  229.       (skip-chars-backward "^\n\r"))
  230.     (if (re-search-forward efs-vos-date-and-time-regexp eol t)
  231.     (point)
  232.       (and raise-error (error "No file on this line")))))
  233.  
  234. (efs-defun efs-dired-manual-move-to-end-of-filename vos
  235.   (&optional no-error bol eol)
  236.   ;; Assumes point is at the beginning of filename.
  237.   ;; So, it should be called only after (dired-move-to-filename t)
  238.   ;; On failure signals an error, or returns nil.
  239.   ;; This is the VOS version.
  240.   (let ((opoint (point)))
  241.     (and selective-display
  242.      (null no-error)
  243.      (eq (char-after
  244.           (1- (or bol (save-excursion
  245.                 (skip-chars-backward "^\r\n")
  246.                 (point)))))
  247.          ?\r)
  248.      ;; File is hidden or omitted.
  249.      (cond
  250.       ((dired-subdir-hidden-p (dired-current-directory))
  251.        (error
  252.         (substitute-command-keys
  253.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  254.       ((error
  255.         (substitute-command-keys
  256.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  257.          )))))
  258.     (skip-chars-forward "-a-zA-Z0-9@[]\\^`{|}~\"$+,./:_")
  259.     (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
  260.     (if no-error
  261.         nil
  262.       (error "No file on this line"))
  263.       (point))))
  264.  
  265. (efs-defun efs-dired-fixup-listing vos (file path &optional switches wildcard)
  266.   ;; VOS listing contain some empty lines, which is inconvenient for dired.
  267.   (goto-char (point-min))
  268.   (skip-chars-forward "\n")
  269.   (delete-region (point-min) (point))
  270.   (while (search-forward "\n\n" nil t)
  271.     (forward-char -2)
  272.     (delete-char 1)))
  273.  
  274. (efs-defun efs-dired-ls-trim vos ()
  275.   ;; Trims VOS dir listings for single files, so that they are exactly one line
  276.   ;; long.
  277.   (goto-char (point-min))
  278.   (let (case-fold-search)
  279.     (re-search-forward efs-vos-date-and-time-regexp))
  280.   (beginning-of-line)
  281.   (delete-region (point-min) (point))
  282.   (forward-line 1)
  283.   (delete-region (point) (point-max)))
  284.  
  285. ;;; end of efs-vos.el
  286.